home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / autouse.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  4.3 KB  |  164 lines
  1. package autouse;
  2.  
  3. use 5.003_90;        # ->can, for my $var
  4.  
  5. $autouse::VERSION = '1.01';
  6.  
  7. $autouse::DEBUG ||= 0;
  8.  
  9. sub vet_import ($);
  10.  
  11. sub croak {
  12.     require Carp;
  13.     Carp::croak(@_);
  14. }
  15.  
  16. sub import {
  17.     my $class = @_ ? shift : 'autouse';
  18.     croak "usage: use $class MODULE [,SUBS...]" unless @_;
  19.     my $module = shift;
  20.  
  21.     (my $pm = $module) =~ s{::}{/}g;
  22.     $pm .= '.pm';
  23.     if (exists $INC{$pm}) {
  24.     vet_import $module;
  25.     local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
  26.     return $module->import(map { (my $f = $_) =~ s/\(.*?\)$// } @_);
  27.     }
  28.  
  29.     my $callpkg = caller(0);
  30.     print "autouse called from $callpkg\n" if $autouse::DEBUG;
  31.  
  32.     my $index;
  33.     for my $f (@_) {
  34.     my $proto;
  35.     $proto = $1 if (my $func = $f) =~ s/\((.*)\)$//;
  36.  
  37.     my $closure_import_func = $func;    # Full name
  38.     my $closure_func = $func;        # Name inside package
  39.     my $index = index($func, '::');
  40.     if ($index == -1) {
  41.         $closure_import_func = "${callpkg}::$func";
  42.     } else {
  43.         $closure_func = substr $func, $index + 2;
  44.         croak "autouse into different package attempted"
  45.         unless substr($func, 0, $index) eq $module;
  46.     }
  47.  
  48.     my $load_sub = sub {
  49.         unless ($INC{pm}) {
  50.         require $pm;
  51.         die $@ if $@;
  52.         vet_import $module;
  53.         }
  54.         *$closure_import_func = \&{"${module}::$closure_func"};
  55.         print "autousing $module; "
  56.           ."imported $closure_func as $closure_import_func\n"
  57.         if $autouse::DEBUG;
  58.         goto &$closure_import_func;
  59.     };
  60.  
  61.     if (defined $proto) {
  62.         *$closure_import_func = eval "sub ($proto) { &\$load_sub }";
  63.     } else {
  64.         *$closure_import_func = $load_sub;
  65.     }
  66.     }
  67. }
  68.  
  69. sub vet_import ($) {
  70.     my $module = shift;
  71.     if (my $import = $module->can('import')) {
  72.     croak "autoused module has unique import() method"
  73.         unless defined(\&Exporter::import)
  74.            && $import == \&Exporter::import;
  75.     }
  76. }
  77.  
  78. 1;
  79.  
  80. __END__
  81.  
  82. =head1 NAME
  83.  
  84. autouse - postpone load of modules until a function is used
  85.  
  86. =head1 SYNOPSIS
  87.  
  88.   use autouse 'Carp' => qw(carp croak);
  89.   carp "this carp was predeclared and autoused ";
  90.  
  91. =head1 DESCRIPTION
  92.  
  93. If the module C<Module> is already loaded, then the declaration
  94.  
  95.   use autouse 'Module' => qw(func1 func2($;$) Module::func3);
  96.  
  97. is equivalent to
  98.  
  99.   use Module qw(func1 func2);
  100.  
  101. if C<Module> defines func2() with prototype C<($;$)>, and func1() and
  102. func3() have no prototypes.  (At least if C<Module> uses C<Exporter>'s
  103. C<import>, otherwise it is a fatal error.)
  104.  
  105. If the module C<Module> is not loaded yet, then the above declaration
  106. declares functions func1() and func2() in the current package, and
  107. declares a function Module::func3().  When these functions are called,
  108. they load the package C<Module> if needed, and substitute themselves
  109. with the correct definitions.
  110.  
  111. =head1 WARNING
  112.  
  113. Using C<autouse> will move important steps of your program's execution
  114. from compile time to runtime.  This can
  115.  
  116. =over
  117.  
  118. =item *
  119.  
  120. Break the execution of your program if the module you C<autouse>d has
  121. some initialization which it expects to be done early.
  122.  
  123. =item *
  124.  
  125. hide bugs in your code since important checks (like correctness of
  126. prototypes) is moved from compile time to runtime.  In particular, if
  127. the prototype you specified on C<autouse> line is wrong, you will not
  128. find it out until the corresponding function is executed.  This will be
  129. very unfortunate for functions which are not always called (note that
  130. for such functions C<autouse>ing gives biggest win, for a workaround
  131. see below).
  132.  
  133. =back
  134.  
  135. To alleviate the second problem (partially) it is advised to write
  136. your scripts like this:
  137.  
  138.   use Module;
  139.   use autouse Module => qw(carp($) croak(&$));
  140.   carp "this carp was predeclared and autoused ";
  141.  
  142. The first line ensures that the errors in your argument specification
  143. are found early.  When you ship your application you should comment
  144. out the first line, since it makes the second one useless.
  145.  
  146. =head1 BUGS
  147.  
  148. If Module::func3() is autoused, and the module is loaded between the
  149. C<autouse> directive and a call to Module::func3(), warnings about
  150. redefinition would appear if warnings are enabled.
  151.  
  152. If Module::func3() is autoused, warnings are disabled when loading the
  153. module via autoused functions.
  154.  
  155. =head1 AUTHOR
  156.  
  157. Ilya Zakharevich (ilya@math.ohio-state.edu)
  158.  
  159. =head1 SEE ALSO
  160.  
  161. perl(1).
  162.  
  163. =cut
  164.